***
***
*** This Program already converted to Y2K
*** S&T Departement     on 29 April 1999 by Ben.Rahman
***
***
set cent on
SET COLO TO BG+/B
CLEAR
SET PROC TO SOSPRO1
SET PROC TO BOXPROC
SET PROC TO LABPROC
STORE ' ' TO AEANAME,AEAADDR,AEACITY,AEACOUN,AEACURR,AEASTNM
STORE .F. TO AEAHEAL,AEADECI,AEASITE
DO START
REST FROM  N:VISPHA addi
PUBLIC VISPH
DR="N:"
DOI=DATE()
store 0 to SWW,sww1,sww2,sww3,cr1,cnt1,PL1,PL2,PL3,PL4,PL5,PL6,PL7,PL8,PL9,PL10,pl11,pl12,PL13,PL14,PL15,PL16,PL17,PL18
store 0 to ndrug, NDISP
STORE .F. TO PATIN,FRUSEL,COMPLT,termin,patid
TGLL=SUBSTR(DTOC(DOI),1,2)
DO WHILE .NOT. PATIN .AND. SWW<3 .AND. LASTKEY()<>27
   SET COLOR TO BG+/B
   @ 0,0 CLEA TO 24,79
   STORE 0 TO TOTL,NPROC,TOTPAY,TOTHL,TOTFEE,TOTPROC,NORE,DQNT,PTOTL,PILC,MTOTL
   STORE SPACE(6) TO KDPAT,KODE
   STORE SPACE(1) TO TPPAT,CRPAT,MNMPAT,ISEX
   STORE SPACE(4) TO DTPAT, COPAT
   STORE SPACE(8) TO MDSNBR
   STORE SPACE(16) TO NMPAT,FNMPAT,NATIO,DEPPER
   STORE CTOD('  /  /    ') TO DOBPAT,HLBEGIN,MDSDAT
   STORE .F. TO HEALTH, HLRES, HLVOID,PERSO,FAMIL,MDS,PREND
   HLDATE=DATE()
   F1='IN_PAT'
   f2='PHARMACY'
   SELE 1
   SET EXCLU OFF
   USE &DR&F1
   DO ADDRESSC
   DO BOXT WITH 3,29,' P H A R M A C Y 27 OCT 06','W+','B',.F.,.T.
   SET COLO TO BG+/B
   @ 6, 3 SAY "SURNAME :"
   @ 6,30 SAY "FIRST NAME :"
   @ 6,60 SAY "MID.INITIAL :"
   @ 7, 3 SAY "DATE OF BIRTH :"
   @ 7,29 SAY "NATIONALITY :"
   @ 7,62 SAY "SEX (M/F) :"
   DO BOXE WITH 3,52,'PATIENT CODE :','KODE','GR+','R','N','W+',6,.F.,.T.
   SET COLO TO BG+/B,W+/N
   IPPAT=.F.
   SELE 1
   
   LOCA FOR PAT_FILCOD=KODE
   IF .NOT. FOUND()
      SWW=SWW+1
      SET COLO TO BG+/B*
      set cons off
      DO BOXF WITH 14,17,'>>>>> WRONG CODE, PLEASE ENTER AGAIN <<<<<','GR+','R','GR+*',.T.,.T.
      WAIT ' '
      set cons on
      SET COLO TO BG+/B
      @ 14,17 CLEA TO 23,78
      PATID=.F.
   ELSE
      PATID=.T.
   ENDIF
   IF PATID
      DO cashipat
      DO BOX2 WITH 20,20,'DO YOU WANT TO :','CONFIRM','CANCEL','W+','B','GR+','N',PL1,.T.,.T.
      IF PL1=1
         PATIN=.T.
      ENDIF
   ENDIF
ENDDO
IF .NOT. PATIN
   RETURN
ENDIF
nore=recno()
f2='PHARMACY'
fill='\temp\la'+kdpat+'.dbf'
film='\temp\ME'+kdpat+'.dbf'
filp='\temp\ph'+kdpat+'.dbf'
*IF FILE("&DR&FILM") .OR. FILE("&DR&FILP")
*   @ 10,1 CLEA TO 23,78
*   DO BOXT WITH 14,20,"   THIS FILE IS USED AT CASHIER STATION   ",'GR+','B',.F.,.F.
*   DO BOXT WITH 16,20,"YOU CANNOT PROCESS LABORATORY EXAMINATIONS",'GR+','B',.F.,.F.
*   DO BOXT WITH 18,20,"    PLEASE, RETURN THE FILE TO CASHIER    ",'GR+','B',.F.,.F.
*   DO BOXT WITH 20,20,"   AND,  TYPE ANY KEY TO RETURN TO MENU   ",'GR+','B',.F.,.F.
*   WAIT " "
*   CLEA
*   RETURN
*ENDIF
f6="\temp\PR"+kdpat
use &dr&f2
copy stru to &dr&f6
sele 6
use &dr&f6
SET COLOR TO BG+/B
@ 11,0 CLEAR to 24,79
VISPH=VISPH+1
NOBER=STR(VISPH,5)
STORE 0 TO TOTL,PHACNT
*DO WHILE .NOT.TERMIN
DO WHILE .NOT. COMPLT .AND. LASTKEY()<>27
   STORE .F. TO MRES,HRES
   STORE 0 TO PLAB,MLAB,HLAB,COSTAL,NUMB,pub
   set color to bg+/b
   @ 9,0 clea to 18,45
   @ 19,0 CLEA TO 24,79
   DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'#,##9.99'),'GR+','B',.F.,.T.
   F9='DRUGS'
   F10='DISPOS'
**   SELE 9
 **  SET EXCLU OFF
  ** USE &DR&F9 INDEX &DR&F9
*   SELE 10
*   SET EXCLU OFF
*   USE &DR&F10 INDE &DR&F10

   ANOD=.T.
   do while anod
      set color to bg+/b
      @ 9,0 clea to 21,79
      @ 22,0 CLEA TO 24,45
      store space(5) to DRUGK,dispk
      store 0 to cntd,crd,DQNT
      STORE SPACE(3) TO DRUGIN,DISPIN
      do box2 with 9,0,"DELIVERY OF :","MEDICATIONS (DRUGS)","DISPOSABLE ITEMS",'w+','bg','w+','n',pl6,.f.,.t.
      if PL6=1
         F9='DRUGS'
         F9A='DRUGNM'
         DRUGK=space(5)
         *DO BOXlab WITH 12,0,'Enter Drugs Code :','DRUGK','gr+','B','gr+','N',5,.F.,.T.
         if DRUGK=SPACE(5)
            do boxi with 12,28,'Enter initial of Drug (trade name)  :','drugin','gr+','b','gr+','n',.f.,.t.
            DO CASH405
            if drugk=space(5)
               loop
            endif
         ENDIF
         SET COLOR TO BG+/B
         @ 9,0 CLEA TO 21,79
         SELE 9
         set exclu off
         use &dr&f9 inde &dr&f9

         SEEK DRUGK
         IF .NOT. EOF()
            NMDR=DRUG_NAME
            TPDR=DRUG_TYPE
            SLUN=TRIM(SELL_UNIT)+' '+TRIM(DRUG_QANT)+' '+TRIM(DRUG_UNIT)
            SEUN=SELL_UNIT
*         IF TPPAT='0' .OR. TPPAT='9'
*             UNPR=EMP_PRICE
*         ELSE
*           IF TPPAT='7'
*              UNPR=TMS_PRICE
*           ELSE
              UNPR=SALE_PRICE
*           ENDIF
*         ENDIF


*            IF TPPAT='7'
*               UNPR=TMS_PRICE
*            ELSE
*               UNPR=SALE_PRICE
*            ENDI

**
**            UNPR=SALE_PRICE

            UNNI=DRUG_UNIT
            QANT=DRUG_QANT
            HLDR=HEALTHLINE

            DO BOXT WITH 9,0,ALLTRIM(NMDR)+' '+ALLTRIM(TPDR)+'  '+SLUN,'W+','B',.F.,.F.
            DO BOXT WITH 11,0,'Price (VND) :'+TRANS(unPR,'##,##9.99')+' Per '+alltrim(seun),'W+','b',.F.,.T.
            DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
            DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
            if dqnt=1
               DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
            else
               DO BOXT WITH 11,56,alltrim(SEUN)+'s','bg+','B',.F.,.F.
            endif



** HUY ADDED 3 OCT 06 ' No surcharge on some item in DP_DICS
** Thien edited on Sep 11st 2008 - Remove surcharge
	                                                                                                                                                                                            
**	IF ALLTRIM(PRGNM) = "TOURIST" .OR. ALLTRIM(PRGNM) = "VISITOR"
		
			
**		IF ALLTRIM(DRUGK)='FV001' .OR. ALLTRIM(DRUGK)='V0059'	

**	         	@ 17,03 SAY 'Normal % '
**			TOTPR=TOTPR
**                ELSE
**			@ 17,03 SAY 'Surcharge 20 % '
**		TOTPR=TOTPR * 1.2  
**	    	ENDIF
                                                                                 
**  	ENDIF                                          
** End Thien edited on Sep 11st 2008.

** HUY END 3 OCT 06 ' No surcharge on some item in DP_DICS






            TOTPR=UNPR*DQNT
      IF LEN(ALLTRIM(PRGNM)) > 0
        *---------------------------------------------------------------------------------- 
        ** Thien added 22 Oct 2008
        ** If PRGNM="CMPP PROGRAM" Then Seek on DP_DISC to get the items that discount 100%
        *----------------------------------------------------------------------------------
        F5='DP_DISC'        
        IF (ALLTRIM(PRGNM) = "CMPP PROGRAM")
        ** Search in DP_DISC to get the drugs code that discount 100%
          SELE 5
          SET EXCLU OFF
          USE &DR&F5 INDE &DR&F5
          GO TOP
          SEEK PRGNM+DRUGK
          IF .NOT. EOF()
            DISC=100
          ENDIF
          IF DISC=100
            @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 100% discount for CMPP'
            TOTPR = TOTPR * 0.0
          ENDIF      
        ENDIF
        *----------------------------------------------------------------------------------
        ** End Thien
        *----------------------------------------------------------------------------------
      ENDIF
            DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'#,##9.99'),'W+','R',.F.,.T.
            do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
            IF PL7=2
               loop
            ELSE
               NDRUG=NDRUG+1
               IF TPPAT='0' .OR. TPPAT='9'
                  IF EMDR
                     HLRES=.F.
                     HPRIC=0
                     PPRIC=0
                     MPRIC=0
                     MSRES=.F.
                  ELSE
                     HLRES=.F.
                     HPRIC=0
                     PPRIC=TOTPR
                     MPRIC=0
                     MSRES=.F.
                  ENDIF
               ELSE

               IF TPPAT='7'
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ELSE

                  IF HLDR .AND. HEALTH .AND. .NOT. HLVOID
                     HLRES=.T.
                     HPRIC=TOTPR
                     PPRIC=0
                     MPRIC=0
                     MSRES=.F.
                  ELSE
                     IF MDS
                        HLRES=.F.
                        HPRIC=0
                        PPRIC=0
                        MPRIC=TOTPR
                        MSRES=.T.
                     ELSE
                        HLRES=.F.
                        HPRIC=0
                        MPRIC=0
                        PPRIC=TOTPR
                        MSRES=.F.
                     ENDIF
                  ENDIF
               endif
               ENDIF
               sele 6
               DO phadr
               TOTL=TOTL+PPRIC
               PTOTL=PTOTL+PPRIC
            endif
         ELSE
          *store space(25) to nmdr
          *store space(16) to tpdr,slun,seun,unni,qant
          *store 0 to unpr,dqnt
          *store .f. to hldr,msdr
          *DO BOXE  WITH 9,0,"DRUGS NAME :",'NMDR','BG+','B','W+','N',16,.F.,.F.
          *DO BOXCS WITH 11,0,'Price (VND) : ','unpr','999,999','BG+','B','W+','N','1000000','0',.F.,.F.
          *DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
          *TOTPR=UNPR*DQNT
          *DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,##9.99'),'W+','R',.F.,.T.
          *do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
          *IF PL7=2
          *   loop
          *ELSE
          *   HLRES=.F.
          *   HPRIC=0
          *   MPRIC=0
          *   PPRIC=TOTPR
          *   MSRES=.F.
          *ENDIF
          *SELE 6
          *DO phaDR
          *TOTL=TOTL+PPRIC
          *PTOTL=PTOTL+PPRIC
      ENDIF
         DO BOXT WITH 19,46,'PHAR. PAYABLE (VND) :'+TRANS(PTOTL,'##,##9.99'),'GR+','b',.F.,.T.
         DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'##,##9.99'),'GR+','b',.F.,.T.
      else
      DispK=space(5)
      STORE(3) TO DISPIN
      *DO BOXlab WITH 12,0,'Enter Disposable Code :','DispK','gr+','B','gr+','N',5,.F.,.T.
      if Dispk=SPACE(5)
         F10='DISPOS'
         F10A='DISPNM'
         do boxo with 12,33,'Enter initial of Disposable item :','dispin','gr+','b','gr+','n',3,.f.,.t.
         DO CASH406
           if dispk=space(5)
               loop
            endif
      endif
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 20,79
 
         SELE 10
         set exclu off
         use &dr&f10 inde &dr&f10

         SEEK DISPK
         IF .NOT. EOF()
            NMDS=DISP_NAME
            TPDS=DISP_TYPE
            SLUN=TRIM(SELL_UNIT)+' '+TRIM(DISP_QANT)+' '+TRIM(DISP_UNIT)
            SEUN=SELL_UNIT
         *IF TPPAT='0' .OR. TPPAT='9'
         *  UNPS=EMP_PRICE
         *ELSE
         *  IF TPPAT='7'
         *     UNPS=TMS_PRICE
         *  ELSE
              UNPS=SALE_PRICE
         *  ENDIF
         *ENDIF


**            UNPS=SALE_PRICE

            UNNI=DISP_UNIT
            QANT=DISP_QANT
            HLDS=HEALTHLINE
            DO BOXT WITH 9,0,ALLTRIM(NMDS)+' '+ALLTRIM(TPDS)+'  '+SLUN,'W+','B',.F.,.F.
            DO BOXT WITH 11,0,'Price : (VND) '+TRANS(UNPS,'##,##9.99')+' Per '+alltrim(seun),'bg+','b',.F.,.T.
            DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
            DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
            TOTPR=UNPS*DQNT
            IF LEN(ALLTRIM(PRGNM)) > 0
              *---------------------------------------------------------------------------------- 
              ** Thien added 22 Oct 2008
              ** If PRGNM="CMPP PROGRAM" Then Seek on DP_DISC to get the items that discount 100%
              *----------------------------------------------------------------------------------
              F5='DP_DISC'        
              IF (ALLTRIM(PRGNM) = "CMPP PROGRAM")
              ** Search in DP_DISC to get the drugs code that discount 100%
                SELE 5
                SET EXCLU OFF
                USE &DR&F5 INDE &DR&F5
                GO TOP
                SEEK PRGNM+DISPK
                IF .NOT. EOF()
                  DISC=100
                ENDIF
                IF DISC=100
                  @ 17,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 100% discount for CMPP'
                  TOTPR = TOTPR * 0.0
                ENDIF      
              ENDIF
              *----------------------------------------------------------------------------------
              ** End Thien
              *----------------------------------------------------------------------------------
            ENDIF
            DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,##9.99'),'w+','r',.F.,.T.
            do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
            IF PL7=2
               loop
            ELSE
               NDISP=NDISP+1
               IF TPPAT='0' .OR. TPPAT='9'
**               IF TPPAT='0' .OR. TPPAT='9' .OR. TPPAT='7'
                  IF EMDS
                     HLRES=.F.
                     HPRIC=0
                     PPRIC=0
                     MPRIC=0
                     MSRES=.F.
                   ELSE
                      HLRES=.F.
                      HPRIC=0
                      PPRIC=TOTPR
                      MPRIC=0
                      MSRES=.F.
                   ENDIF
               ELSE
               IF TPPAT='7'
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ELSE

                  IF HLDS .AND. HEALTH .AND. .NOT. HLVOID
                     HLRES=.T.
                     HPRIC=TOTPR
                     PPRIC=0
                     MPRIC=0
                     MSRES=.F.
                  ELSE
                     IF MDS
                        HLRES=.F.
                        HPRIC=0
                        MPRIC=TOTPR
                        PPRIC=0
                        MSRES=.T.
                     ELSE
                        HLRES=.F.
                        HPRIC=0
                        PPRIC=TOTPR
                        MPRIC=0
                        MSRES=.F.
                     ENDIF
                  ENDIF
               ENDIF
               endif
               sele 6
               DO phads
               TOTL=TOTL+PPRIC
               PTOTL=PTOTL+PPRIC
            endif
         else
          store space(25) to nmds
          store space(16) to tpds,slun,seun,unni,qant
          store 0 to unps,dqnt
          store .f. to hlds,msds
          *DO BOXE  WITH 9,0,"DISPOSABLE NAME :",'NMDS','BG+','B','W+','N',16,.F.,.F.
          *DO BOXCS WITH 11,0,'Price (VND) : ','unps','999,999','BG+','B','W+','N','1000000','0',.F.,.F.
          *DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
          TOTPR=UNPS*DQNT
          *DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,##9.99'),'W+','R',.F.,.T.
          *do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
          *IF PL7=2
          *   loop
          *ELSE
          *   HLRES=.F.
          *   HPRIC=0
          *   MPRIC=0
          *   PPRIC=TOTPR
          *   MSRES=.F.
          *ENDIF
          *ELE 6
          *DO phads
          *TOTL=TOTL+PPRIC
          *PTOTL=PTOTL+PPRIC

      endif
         DO BOXT WITH 19,46,'PHAR. PAYABLE (VND) :'+TRANS(PTOTL,'##,##9.99'),'GR+','B',.F.,.T.
         DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'##,##9.99'),'GR+','B',.F.,.T.
      ENDIF
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 18,79
      @ 20,0 CLEA TO 24,45
      DO BOX2 WITH 22,0,'Other Drugs or Disposable items :','YES','NO','gr+','r','W+','N',PL8,.F.,.t.

      if pl8=2
         anod=.f.
      endif
   ENDDO
   SELE 6
   if reccount()=0
      return
   endif
   pde=.t.
   do while pde
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 24,79
      DO BOXF WITH 9,0,"REVIEW THE INVOICE. Type 'Esc' if correct, 'Enter' To Delete one item",'GR+','R','GR+*',.F.,.T.
      DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(totl,'##,##9.99'),'GR+','B',.F.,.T.
      GO TOP
      CNT=RECCOUNT()
      DECLARE PPRC[CNT]
      declare PHAc[cnt]
      declare fil1[cnt]
      declare recn[cnt]
      cr=0
      go top
      do while .not. eof()
         cr=cr+1
         PPRC[CR]=PHAR_PAY
         PHAc[cr]=PHAR_CODE
         fil1[cr]=PHAR_CODE+CHR(179)+SPACE(2)+PHAR_NAME+PHAR_TYPE+PHAR_QANT+' '+CHR(179)+' '+str(PHAR_X,4)+space(1)+CHR(179)+trans(SALE_PRICE,'##,##9.99')+' '+CHR(179)+' '+TRANS(PHAR_PAY,'###,##9.99')
         recn[cr]=recno()
         skip
      enddo
      set color to w+/b
      @ 17,0 to 21,79 double
      set colo to g+/B,W+/N
      pilih=achoice(18,2,20,76,fil1)
      IF LASTKEY()=13
         recdel=recn[pilih]
         PPRIC=PPRC[PILIH]
         sele 6
         go recdel
         @ 12,0 clea to 16,79
         do box2 with 12,0,'Delete item '+alltrim(PHAR_NAME)+' '+ALLTRIM(PHAR_TYPE)+' :','YES','NO','w+','b','W+','n',pl10,.f.,.f.
         if pl10=1
            STORE .T. TO PDE,PDEL
            if rec_lock(0)
               DELE
            ENDIF
            UNLOCK
            totl=totl-PPRIC
            ptotl=ptotl-ppric
            SELE 6
*            USE
            IF NET_USE("&DR&F6",.T.,'6',10)
               PACK
            ENDIF
            SET EXCLU OFF
            STOR .F. TO PDE
         else
            STOR .F. TO PDE, PDEL
         endif
      else
         STOR .F. TO PDE, PDEL
      endif
   enddo
   SET COLOR TO BG+/B
   @ 9,0 CLEA TO 21,79
   @ 22,0 CLEA TO 24,45
   IF PDEL
      DO BOX2 WITH 9,0,'DO YOU WANT TO REPLACE DELETED ITEMS ?','YES','NO','GR+','RB','GR+','N',PL11,.F.,.T.
      IF PL11=1
         complt=.f.
**         CLOS ALL
         LOOP
      ELSE
         COMPLT=.T.
      ENDIF
   ELSE
      COMPLT=.T.
   Endif
enddo


*****  ADD PRESCRIPTION TO n:\temp\phar_his AS DOCUMENTTAION
F24="\TEMP\PHAR_HIS\HISTORY.DBF"
SELE 24
USE &DR&F24
F6="\TEMP\PR"+kdpat
APPEN FROM &DR&F6
CLOSE ALL
RETU
